home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
PWAECS20.ZIP
/
ECS.PPS
< prev
next >
Wrap
Text File
|
1995-03-26
|
10KB
|
301 lines
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Enhanced Comment to Sysop v2.0
; Written by Drew [PWA]
; Last updated 03-25-95
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; function/procedure prototypes (declarations)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
declare procedure Initialize()
declare procedure PrintMenu()
declare procedure SaveState(int cr, int cc, int cs, var string st, \
var int sr, var int sc)
declare procedure PrintState(string st, int cr, int cc, int cs)
declare procedure RestoreState(string st, int sr, int sc)
declare procedure ParseSelected(int cursysop)
declare procedure CheckSysNum(int a, var boolean q, var string s, \
var int sr, var int sc, int cs, int cr, int cc)
declare procedure PrintQuit()
declare procedure GetInput()
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; some global variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
boolean hl_numb ; highlight sysop number or not
string color_num ; color of unlighted sysop number
string color_high_num ; color of highlighted sysop number
string subj ; subject of comment to sysop
integer numsysops ; number of sysops user can leave comment to
integer numspaces ; numb of spaces after sysop numb to sysop name
string sysnames(1) ; stores the sysop names (redimensioned array)
string sysdescs(1) ; stores the sysop descriptions (redim'ed)
string rowpos(1) ; stores x-positions
string colpos(1) ; stores y-positions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; main
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
begin
Initialize()
startdisp FNS
GetInput()
PrintQuit()
resetdisp
startdisp NC
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; gets input from the user and manages the lightbars
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
procedure GetInput()
string save_text ; saves text before highlighting
int save_row ; saves old row
int save_col ; saves old column
int cursysop ; current sysop number
int currow ; current row
int curcol ; current column
int ascii ; ascii # of keyboard input
boolean quit ; quit or not
; print menu, move cursor to first sysop
;
PrintMenu()
cursysop = 1
currow = rowpos(1)
curcol = colpos(1)
ansipos curcol, currow
; save state and print highlighted
;
SaveState(currow, curcol, cursysop, save_text, save_row, save_col)
PrintState(save_text, currow, curcol, cursysop)
quit = FALSE
while (quit == FALSE) do
; let's be nice to the cpu and use a small delay
delay 1
ascii = asc(inkey())
select case (ascii)
case 13
; return
ParseSelected(cursysop)
quit = TRUE
case 85, 65, 97, 76
; up arrow, or "A" or "a"
RestoreState(save_text, save_row, save_col)
dec cursysop
if (cursysop < 1) cursysop = numsysops
currow = rowpos(cursysop)
curcol = colpos(cursysop)
SaveState(currow, curcol, cursysop, save_text, save_row, \
save_col)
PrintState(save_text, currow, curcol, cursysop)
case 68, 90, 122, 82
; down arrow, or "Z" or "z"
RestoreState(save_text, save_row, save_col)
inc cursysop
if (cursysop > numsysops) cursysop = 1
currow = rowpos(cursysop)
curcol = colpos(cursysop)
SaveState(currow, curcol, cursysop, save_text, save_row, \
save_col)
PrintState(save_text, currow, curcol, cursysop)
case 113, 27, 81
; ESCape, "Q" or "q"
quit = TRUE
default
; user has hit some other key, so check if it's a sysop number
CheckSysNum(ascii, quit, save_text, save_row, save_col, \
cursysop, currow, curcol)
endselect
endwhile
endproc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; i hope no one minds. :)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
procedure PrintQuit()
getuser
defcolor
ansipos 1, u_pagelen
println "@X08ECS v2.0 by Drew [PWA]@X07"
endproc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; user has entered something other than the lightbar keys, so check if it's
; a matching number for one of the sysops listed
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
procedure CheckSysNum(int ascii, var boolean quit, var string save_text,\
var int save_row, var int save_col, int cursysop, int currow, int curcol)
int num
quit = FALSE
num = s2i(chr(ascii), 10)
if (num && (num <= numsysops)) then
RestoreState(save_text, save_row, save_col)
cursysop = num
currow = rowpos(cursysop)
curcol = colpos(cursysop)
SaveState(currow, curcol, cursysop, save_text, save_row, save_col)
PrintState(save_text, currow, curcol, cursysop)
ParseSelected(cursysop)
quit = TRUE
endif
endproc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; User has hit RETURN or has hit a valid hotkey (sysop number), so stuff
; keyboard to correct sysop
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
procedure ParseSelected(int cursysop)
kbdstuff "E" + CHR(13) + sysnames(cursysop) + CHR(13) + subj + \
CHR(13) + "R" + CHR(13)
endproc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; restores text that was highlighted after the lightbar has moved
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
procedure RestoreState(string save_text, int save_row, int save_col)
if (hl_numb == TRUE) then
ansipos save_col - 1, save_row
print save_text
else
ansipos save_col + numspaces, save_row
print save_text
endif
endproc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; print the lightbar
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
procedure PrintState(string save_text, int currow, int curcol, \
int cursysop)
if (hl_numb == TRUE) then
ansipos curcol - 1, currow
print color_high_num + stripatx(save_text)
backup 1
else
ansipos curcol + numspaces, currow
print sysdescs(cursysop)
backup 1
endif
endproc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; save the text about to be printed over from the lightbar
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
procedure SaveState(int currow, int curcol, int cursysop, \
var string save_text, var int save_row, var int save_col)
save_row = currow
save_col = curcol
if (hl_numb == TRUE) then
save_text = scrtext(save_col - 1, save_row, 3, TRUE)
else
save_text = scrtext(save_col + numspaces, save_row, \
len(stripatx(sysdescs(cursysop))) , TRUE)
endif
endproc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; prints the menu/ansi screen
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
procedure PrintMenu()
if (exist(ppepath() + "ECS.PCB")) then
dispfile ppepath() + "ECS.PCB", DEFS
else
cls
println "@X0CError! Missing ECS.PCB - Inform your main sysop!@X07"
end
endif
endproc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; duh
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
procedure Initialize()
string ecs_cfg, tmpstr1
int i
ecs_cfg = ppepath() + "ECS.CFG"
if (!exist(ecs_cfg)) then
println "@X0CError! ECS.CFG not found!@X07"
end
endif
fopen 1, ecs_cfg, O_RD, S_DW
fdefin 1
fdget tmpstr1
if (upper(tmpstr1) == "N") then
hl_numb = TRUE
elseif (upper(tmpstr1) == "D") then
hl_numb = FALSE
endif
fdget color_high_num
fdget tmpstr1
numspaces = s2i(tmpstr1, 10)
fdget subj
; i don't trust ppl with their 0-based arrays, since it seems like it
; is and isn't at the same time. so just to be safe, we'll redimension
; the arrays to one size larger and just not use the zero-th (first)
; element.
;
fdget tmpstr1
numsysops = s2i(tmpstr1, 10)
redim sysnames, numsysops + 1
redim sysdescs, numsysops + 1
redim rowpos, numsysops + 1
redim colpos, numsysops + 1
for i = 1 to numsysops
fdget tmpstr1
tokenize tmpstr1
rowpos(i) = s2i(gettoken(), 10)
colpos(i) = s2i(gettoken(), 10)
fdget sysdescs(i)
fdget sysnames(i)
next i
fclose 1
endproc